# TODO: Add comment
# 
# Author: dkor
###############################################################################



###############
# MYCLICKFOCUS #
###############

posClickFocus <-
		function(x,
				y)
{
	col_row <-myClickFocus(x,y)
#print_debug(col_row)
	
	col = as.numeric(col_row[[1]])
	row = as.numeric(col_row[[2]])
#return(c(viz$condlevels[1],viz$condlevels[1]))
#return(c(viz$condlevels[1]$condY[[cols[0]]][1],
#         viz$condlevels[1]$condX[[cols[1]]][1]))
	
#print_debug(c("col",col))
#print_debug(c("row",row))
	
#print_debug(viz$condlevels[1]$condY[[col]][1])
#print_debug(viz$condlevels[1]$condY[[row]][1])
	
	
#return(col, row, c(viz$condlevels[1]$condX[[1]],
#         viz$condlevels[1]$condY[[1]]))
}

oldFocusCol = -1  ### New
oldFocusRow = -1 ### New

myClickFocus <-
		function(x,
				y,
				clip.off = FALSE,
				highlight = interactive(),
				...,
				guess = TRUE,
				verbose = FALSE)
{
	library(lattice) ### New
	library(grid)   ### New
	library(latticeExtra) ### New
	
	layoutMatrix <- trellis.currentLayout()
	if (guess && sum(layoutMatrix > 0) == 1)
	{
		## there's only one panel, so just select it
		w <- which(layoutMatrix > 0)
		focusRow <- row(layoutMatrix)[w]
		focusCol <- col(layoutMatrix)[w]
		#if (verbose) message(sprintf("Selecting panel at position (%g, %g)", focusRow, focusCol))
	}
	else if (all(layoutMatrix == 0))
	{
		warning("No panels available")
		return()
	}
	else 
	{
		#if (verbose) message("Click on panel to focus")
		myFocus("figure", highlight = FALSE) ### New
		#message("Click on panel to focus 2")
		x <- grconvertX(x, "device", "npc") ### New
		y <- grconvertY(y, "device", "npc") ### New
		x <- unit(x, "native") ### New
		y <- unit(y, "native") ### New
		clickLoc = list(x=x,y=y)  ### New, changed from <- grid.locator("npc")
		#clickLoc <- grid.locator("npc")
		if (is.null(clickLoc)) return()
		focusCol <- ceiling(as.numeric(clickLoc$x) * ncol(layoutMatrix))
		focusRow <- ceiling(as.numeric(clickLoc$y) * nrow(layoutMatrix))
		if (lattice:::lattice.getStatus("as.table"))
			focusRow <- nrow(layoutMatrix) - focusRow + 1
		myUnfocus()
	}
	if ((focusCol >= 1) && (focusCol <= ncol(layoutMatrix)) &&
			(focusRow >= 1) && (focusRow <= nrow(layoutMatrix)) &&
			layoutMatrix[focusRow, focusCol] > 0 )
	{
		if (focusCol != oldFocusCol  || oldFocusRow  != focusRow )  ### New
		{                                                                                                          ### New
			myFocus("panel", column = focusCol, row = focusRow,         ### New
					clip.off = clip.off, highlight = FALSE,
					...)
		}
		else ### New
		{      ### New
		}    ### New
	}
	else
	{
		focusCol <- focusRow <- 0
	}
	invisible(list(col=focusCol, row=focusRow))
	debugStr =  trellis.vpname()
	oldFocusCol  <<- focusCol                ### New
	oldFocusRow  <<- focusRow             ### New
	return(c(focusCol, focusRow))
}

##########
# UNFOCUS #
##########

myUnfocus <-
		function()
## mainly, undo highlighting
{
	if (lattice:::lattice.getStatus("vp.highlighted"))
	{
		#grid:::grid.remove("lvp.highlight", warn = FALSE)
		lattice:::lattice.setStatus(vp.highlighted = FALSE)
	}
	lattice:::lattice.setStatus(current.focus.column = 0,
			current.focus.row = 0)
	if (lattice:::lattice.getStatus("vp.depth") > 0)
		upViewport(lattice:::lattice.getStatus("vp.depth"))
	lattice:::lattice.setStatus(vp.depth = 0)
	invisible()
}

###########
# MY FOCUS #
##########

myFocus <-
		function(name,
				column = stop("column must be specified"),
				row = stop("row must be specified"),
				side = NULL,
				clip.off = FALSE,
				highlight = interactive(),
				...,
				guess = TRUE,
				verbose = getOption("verbose"))
{
	myUnfocus()
	
	if (missing(name) && missing(column) && missing(row))
		return(trellis.myClickFocus(clip.off = clip.off,
						highlight = highlight,
						...,
						guess = guess,
						verbose = verbose))
	
	if (name %in% c("panel", "strip", "strip.left"))
	{
		ll <- lattice:::lattice.getStatus("current.panel.positions")
		if (column > 0 && row > 0 &&
				column <= ncol(ll) && row <= nrow(ll) &&
				ll[row, column] > 0) ## to disallow empty positions
		{
			lattice:::lattice.setStatus(current.focus.column = column,
					current.focus.row = row)
		}
		else
			stop("panel position unspecified or invalid")
	}
	else ## this is for calls from trellis.switchFocus
	{
		if (!missing(row)) lattice:::lattice.setStatus(current.focus.row = row)
		if (!missing(column)) lattice:::lattice.setStatus(current.focus.column = column)
	}
	lattice:::lattice.setStatus(vp.depth = downViewport(trellis.vpname(name,
							side = side, clip.off = clip.off)))
	if (highlight )
	{
		lattice:::lattice.setStatus(vp.highlighted = TRUE)
		gp <- do.call("gpar",
				lattice:::updateList(lattice:::lattice.getOption("highlight.gpar"),
						list(...)))
		lvp <- grid:::rectGrob(name = "lvp.highlight", gp = gp)
		grid:::grid.draw(lvp)
	}
	else
	{
		lattice:::lattice.setStatus(vp.highlighted = FALSE)
	}
	invisible()
}


#TODO: Finish implementing this functionality
update_cell <- function(col_num, row_num, file)
{
	dat = read.csv(filename, skip=6, header = TRUE)
	trellis.focus("panel", column = col_num, row = row_num, highlight=FALSE)
}

#TODO: Finish implementing this functionality
update_plot <-function(filename)
{
	load_dat("cell-output.csv")
	plot_viz('X.step.', 'count.turtles',
			'INITIAL.NUMBER.SHEEP', 'INITIAL.NUMBER.WOLVES')
}


################################################################
####################### LEGACY CODE #############################
################################################################

#source("interface.R")
#init_dat('INITIAL.NUMBER.WOLVES', 100.0, 250.0, 75.0 ,'INITIAL.NUMBER.SHEEP', 50.0, 250.0, 75.0)
#plot_viz('Wolf Sheep Predation Model', 'dummy', 'X.step.', 'INITIAL.NUMBER.SHEEP', 'INITIAL.NUMBER.WOLVES')
init_dat <- function (condXName, xfirst, xlast, xstep, condYName, yfirst, ylast ,ystep)
{
	print_debug(c(1, condXName, condYName))
	condXName = make.names(condXName)
	condYName = make.names(condYName)
	print_debug(2)
	
	x = seq(xfirst, xlast, xstep)
	y = seq(yfirst, ylast, ystep)
	#dat <<- expand.grid( INITIAL.NUMBER.SHEEP = x, INITIAL.NUMBER.WOLVES= y)
	# STUCK HERE !!!!!!!!!!!!
	dat <<- eval(parse(cat('expand.grid( ',condXName,'= x, ',condYName,'= y)')))
	# TRYING TO MAKE STRING  PASS AS DATA FRAME VARIABLE NAMES
	# GRRR EVAL ONLY WORKS IN A INDEPENDENT ENVIRONEMENT
	print_debug(3)
	dat$dummy <<- 1
	print_debug(4)
	dat$X.step. <<-  1
	print_debug(5)
	dat$X.run.number. <<-  NA
	print_debug(6)
	dat$dataset <<-  NA
}